<!-- This HTML file has been created by texi2html 1.30
     from ../r4rs.texi on 14 July 1994 -->

<TITLE>Scheme - Example</TITLE>
<P>Go to the <A HREF="r4rs_10.htm">previous</A>, <A HREF="r4rs_12.htm">next</A> section.<P>
<H1><A NAME="SEC80" HREF="r4rs_toc.htm#SEC80">Example</A></H1>
<P>
<CODE>Integrate-system</CODE> integrates the system
<A NAME="IDX718"></A>
<P>
<I>y_k' = f_k(y_1, y_2, ..., y_n), ; k = 1, ..., n</I>
<P>
of differential equations with the method of Runge-Kutta.
<P>
The parameter <CODE>system-derivative</CODE> is a function that takes a system
state (a vector of values for the state variables y_1, ..., y_n)
and produces a system derivative (the values y_1', ..., y_n').
The parameter <CODE>initial-state</CODE> provides an initial
system state, and <CODE>h</CODE> is an initial guess for the length of the
integration step.
<P>
The value returned by <CODE>integrate-system</CODE> is an infinite stream of
<A NAME="IDX719"></A>
system states.
<P>
<PRE>
<TT>(define integrate-system
  (lambda (system-derivative initial-state h)
    (let ((next (runge-kutta-4 system-derivative h)))
      (letrec ((states
                (cons initial-state
                      (delay (map-streams next
                                          states)))))
        states))))</TT>
</PRE>
<P>
<CODE>Runge-Kutta-4</CODE> takes a function, <CODE>f</CODE>, that produces a
<A NAME="IDX720"></A>
system derivative from a system state.  <CODE>Runge-Kutta-4</CODE>
<A NAME="IDX721"></A>
produces a function that takes a system state and
produces a new system state.
<P>
<PRE>
<TT>(define runge-kutta-4
  (lambda (f h)
    (let ((*h (scale-vector h))
          (*2 (scale-vector 2))
          (*1/2 (scale-vector (/ 1 2)))
          (*1/6 (scale-vector (/ 1 6))))
      (lambda (y)
        ;; y is a system state
        (let* ((k0 (*h (f y)))
               (k1 (*h (f (add-vectors y (*1/2 k0)))))
               (k2 (*h (f (add-vectors y (*1/2 k1)))))
               (k3 (*h (f (add-vectors y k2)))))
          (add-vectors y
            (*1/6 (add-vectors k0
                               (*2 k1)
                               (*2 k2)
                               k3))))))))

(define elementwise
  (lambda (f)
    (lambda vectors
      (generate-vector
        (vector-length (car vectors))
        (lambda (i)
          (apply f
                 (map (lambda (v) (vector-ref  v i))
                      vectors)))))))

(define generate-vector
  (lambda (size proc)
    (let ((ans (make-vector size)))
      (letrec ((loop
                (lambda (i)
                  (cond ((= i size) ans)
                        (else
                         (vector-set! ans i (proc i))
                         (loop (+ i 1)))))))
        (loop 0)))))

(define add-vectors (elementwise +))

(define scale-vector
  (lambda (s)
    (elementwise (lambda (x) (* x s)))))</TT>
</PRE>
<P>
<CODE>Map-streams</CODE> is analogous to <CODE>map</CODE>: it applies its first
<A NAME="IDX723"></A>
<A NAME="IDX722"></A>
argument (a procedure) to all the elements of its second argument (a
stream).
<P>
<PRE>
<TT>(define map-streams
  (lambda (f s)
    (cons (f (head s))
          (delay (map-streams f (tail s))))))</TT>
</PRE>
<P>
Infinite streams are implemented as pairs whose car holds the first
element of the stream and whose cdr holds a promise to deliver the rest
of the stream.
<P>
<PRE>
<TT>(define head car)
(define tail
  (lambda (stream) (force (cdr stream))))</TT>
</PRE>
<A NAME="IDX724"></A>
<P>
The following illustrates the use of <CODE>integrate-system</CODE> in
integrating the system
<P>
<I>C (dvC / dt) = -iL - (vC / R)</I>
<P>
<I>L (diL / dt) = vC</I>
<P>
which models a damped oscillator.
<P>
<PRE>
<TT>(define damped-oscillator
  (lambda (R L C)
    (lambda (state)
      (let ((Vc (vector-ref state 0))
            (Il (vector-ref state 1)))
        (vector (- 0 (+ (/ Vc (* R C)) (/ Il C)))
                (/ Vc L))))))

(define the-states
  (integrate-system
     (damped-oscillator 10000 1000 .001)
     '#(1 0)
     .01))</TT>
</PRE>
<P>
<P>Go to the <A HREF="r4rs_10.htm">previous</A>, <A HREF="r4rs_12.htm">next</A> section.<P>
&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>&nbsp;<p>